home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Cream of the Crop 26
/
Cream of the Crop 26.iso
/
program
/
p063b9s.zip
/
UNIT
/
COM.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1997-03-02
|
22KB
|
897 lines
UNIT Com;
{╔══════════════════════════════════════════════════════════════════════════╗}
{║ Communication routines Last changed: 02.03.97 SA ║}
{║ ║}
{║ (C) Copyright 1989-97 by ║}
{║ Dan Wulff, Jens Sandalgaard, Steen Christensen & S¢ren Ager ║}
{║ ║}
{║ This source may not be given to anybody, without the written permission ║}
{║ from The Portal Team. ║}
{╚══════════════════════════════════════════════════════════════════════════╝}
{$I POPDEFS.INC}
{$IFDEF PMode}
{$C FIXED PRELOAD PERMANENT}
{$ENDIF}
INTERFACE
USES Use32, {$IFDEF OS2}OS2Def, {$IFDEF MaxComm}MaxComm, {$ENDIF}{$ENDIF}
Dos, OpRoot, PoPTypes;
CONST
TxBufSize = 4096;
RxBufSize = 2048;
TYPE
AStatus = Word;
PRealModeRegs = ^TRealModeRegs;
TRealModeRegs = record
case Integer of
0: (
EDI, ESI, EBP, EXX, EBX, EDX, ECX, EAX: Longint;
Flags, ES, DS, FS, GS, IP, CS, SP, SS: Word);
1: (
DI, DIH, SI, SIH, BP, BPH, XX, XXH: Word;
case Integer of
0: (
BX, BXH, DX, DXH, CX, CXH, AX, AXH: Word);
1: (
BL, BH, BLH, BHH, DL, DH, DLH, DHH,
CL, CH, CLH, CHH, AL, AH, ALH, AHH: Byte));
END;
PAbsCom = ^TAbsCom;
TAbsCom = OBJECT(Root)
LastStatus : AStatus;
TxBuf : Pointer;
TxBufPos : Word;
RxBuf : Pointer;
RxBufPos : Word;
RxBufMax : Word;
CurrentBaud : Word;
ParityBits : Byte;
StopBits : Byte;
DataBits : Byte;
CONSTRUCTOR Init(APort: Byte);
DESTRUCTOR Done; VIRTUAL;
FUNCTION SetBaudRate(ABaudRate: Word): Boolean; VIRTUAL;
PROCEDURE SetCurrentBaud(ABaudRate: Word); VIRTUAL;
FUNCTION GetBaudRate: Word; VIRTUAL;
PROCEDURE WriteByte(AByte: Byte; Flush: Boolean); VIRTUAL;
PROCEDURE WriteStr(AStr: String); VIRTUAL;
FUNCTION ReadByte: Byte; VIRTUAL;
FUNCTION Peek(VAR AByte: Byte) : Boolean; VIRTUAL;
FUNCTION KeyPressed: Boolean; VIRTUAL;
FUNCTION OutEmpty: Boolean; VIRTUAL;
FUNCTION Carrier: Boolean; VIRTUAL;
PROCEDURE FlushTx; VIRTUAL;
PROCEDURE FlushOut; VIRTUAL;
PROCEDURE PurgeOut; VIRTUAL;
PROCEDURE PurgeIn; VIRTUAL;
PROCEDURE SetDtr(High: Boolean); VIRTUAL;
PROCEDURE SendBreak; VIRTUAL;
PROCEDURE SetXOn(AMode: Boolean); VIRTUAL;
PROCEDURE SetFlowControl(AMask: Word); VIRTUAL; { 9=Xon/Xoff 2=CTS/RTS }
PROCEDURE SetBreak(AMode: Boolean); VIRTUAL;
PROCEDURE SetLinkData(DB,SB,PB: BYTE); VIRTUAL;
FUNCTION GetLinkData: S5; VIRTUAL;
PRIVATE
PROCEDURE WriteBlock(VAR ABuffer; ABufSize: Word); VIRTUAL;
PROCEDURE ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word); VIRTUAL;
FUNCTION GetStatus: AStatus; VIRTUAL;
END;
PFossilCom = ^TFossilCom;
TFossilCom = OBJECT(TAbsCom)
CurrentPort : Byte;
CONSTRUCTOR Init(APort: Byte);
DESTRUCTOR Done; VIRTUAL;
FUNCTION SetBaudRate(ABaudRate: Word): Boolean; VIRTUAL;
FUNCTION ReadByte: Byte; VIRTUAL;
FUNCTION KeyPressed: Boolean; VIRTUAL;
FUNCTION OutEmpty: Boolean; VIRTUAL;
FUNCTION Carrier: Boolean; VIRTUAL;
PROCEDURE FlushOut; VIRTUAL;
PROCEDURE PurgeOut; VIRTUAL;
PROCEDURE PurgeIn; VIRTUAL;
PROCEDURE SetDtr(High: Boolean); VIRTUAL;
PROCEDURE SendBreak; VIRTUAL;
PROCEDURE SetXOn(AMode: Boolean); VIRTUAL;
PROCEDURE SetFlowControl(AMask: Word); VIRTUAL; { 9=Xon/Xoff 2=CTS/RTS }
PROCEDURE SetBreak(AMode: Boolean); VIRTUAL;
PRIVATE
{$IFDEF PMode}
Regs : TRealModeRegs;
{$ELSE}
Regs : Registers;
{$ENDIF}
PROCEDURE WriteBlock(VAR ABuffer; ABufSize: Word); VIRTUAL;
PROCEDURE ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word); VIRTUAL;
FUNCTION GetStatus: AStatus; VIRTUAL;
PROCEDURE FossilInt(AService: Byte); VIRTUAL;
END;
{$IFDEF OS2}
POS2Com = ^TOS2Com;
TOS2Com = OBJECT(TAbsCom)
CurrentPort : Byte;
ComHandle : HFile;
CONSTRUCTOR Init(APort: Byte);
DESTRUCTOR Done; VIRTUAL;
FUNCTION SetBaudRate(ABaudRate: Word): Boolean; VIRTUAL;
FUNCTION ReadByte: Byte; VIRTUAL;
FUNCTION KeyPressed: Boolean; VIRTUAL;
FUNCTION OutEmpty: Boolean; VIRTUAL;
FUNCTION Carrier: Boolean; VIRTUAL;
PROCEDURE FlushOut; VIRTUAL;
PROCEDURE PurgeOut; VIRTUAL;
PROCEDURE PurgeIn; VIRTUAL;
PROCEDURE SetDtr(High: Boolean); VIRTUAL;
PROCEDURE SendBreak; VIRTUAL;
PROCEDURE SetXOn(AMode: Boolean); VIRTUAL;
PROCEDURE SetFlowControl(AMask: Word); VIRTUAL; { 9=Xon/Xoff 2=CTS/RTS }
PROCEDURE SetBreak(AMode: Boolean); VIRTUAL;
PRIVATE
PROCEDURE WriteBlock(VAR ABuffer; ABufSize: Word); VIRTUAL;
PROCEDURE ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word); VIRTUAL;
FUNCTION GetStatus: AStatus; VIRTUAL;
PROCEDURE ChkErr(ErrCode: ApiRet; DosCall, FctName: S40);
END;
{$IFDEF MaxComm}
PMaxCom = ^TMaxCom;
TMaxCom = OBJECT(TAbsCom)
CurrentPort : Byte;
ComHandle : HComm;
CONSTRUCTOR Init(APort: Byte);
DESTRUCTOR Done; VIRTUAL;
FUNCTION SetBaudRate(ABaudRate: Word): Boolean; VIRTUAL;
FUNCTION ReadByte: Byte; VIRTUAL;
FUNCTION KeyPressed: Boolean; VIRTUAL;
FUNCTION OutEmpty: Boolean; VIRTUAL;
FUNCTION Carrier: Boolean; VIRTUAL;
PROCEDURE FlushOut; VIRTUAL;
PROCEDURE PurgeOut; VIRTUAL;
PROCEDURE PurgeIn; VIRTUAL;
PROCEDURE SetDtr(High: Boolean); VIRTUAL;
PROCEDURE SendBreak; VIRTUAL;
PROCEDURE SetXOn(AMode: Boolean); VIRTUAL;
PROCEDURE SetFlowControl(AMask: Word); VIRTUAL; { 9=Xon/Xoff 2=CTS/RTS }
PROCEDURE SetBreak(AMode: Boolean); VIRTUAL;
PRIVATE
PROCEDURE WriteBlock(VAR ABuffer; ABufSize: Word); VIRTUAL;
PROCEDURE ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word); VIRTUAL;
FUNCTION GetStatus: AStatus; VIRTUAL;
PROCEDURE ChkErr(ErrCode: ApiRet; DosCall, FctName: S40);
END;
{$ENDIF}
{$ENDIF}
IMPLEMENTATION
USES {$IFDEF OS2}OS2Base, OpString, Strings, LogFile, {$ENDIF}
Util, MTask;
CONST
RDA = 1;
OVRN = 2;
THRE = 32;
TSRE = 64;
CarrierMask = $80;
{$IFDEF PMode}
PROCEDURE RealModeInt(Int: Byte; VAR Regs: TRealModeRegs); ASSEMBLER;
ASM
MOV BL,Int
XOR BH,BH
XOR CX,CX
LES DI,Regs
MOV AX,0300H
INT 31H
END;
{$ENDIF}
{=== TAbsCom ===}
CONSTRUCTOR TAbsCom.Init(APort: Byte);
BEGIN
IF NOT INHERITED Init THEN Fail;
LastStatus:=0;
RxBufPos:=0; RxBufMax:=0;
GetMem(RxBuf, RxBufSize);
TxBufPos:=0;
GetMem(TxBuf, TxBufSize);
ParityBits:=0;
StopBits:=0;
DataBits:=3;
END;
DESTRUCTOR TAbsCom.Done;
BEGIN
Dispose(TxBuf);
Dispose(RxBuf);
INHERITED Done;
END;
FUNCTION TAbsCom.SetBaudRate(ABaudRate: Word): Boolean;
BEGIN
CurrentBaud:=ABaudRate;
SetBaudRate:=True;
END;
PROCEDURE TAbsCom.SetCurrentBaud(ABaudRate: Word);
BEGIN
CurrentBaud:=ABaudRate;
END;
FUNCTION TAbsCom.GetBaudRate: Word;
BEGIN
GetBaudRate:=CurrentBaud;
END;
PROCEDURE TAbsCom.WriteByte(AByte: Byte; Flush: Boolean);
BEGIN
BT0(TxBuf^)[TxBufPos]:=AByte;
Inc(TxBufPos);
IF (TxBufPos=TxBufSize) OR Flush THEN
BEGIN
WriteBlock(TxBuf^, TxBufPos);
TxBufPos:=0;
END;
END;
PROCEDURE TAbsCom.WriteStr(AStr : String);
VAR
a : Byte;
BEGIN
FOR a:=1 TO Length(AStr) DO
WriteByte(Byte(AStr[a]), a=Length(AStr));
END;
FUNCTION TAbsCom.ReadByte: Byte;
BEGIN
ReadByte:=0;
END;
FUNCTION TAbsCom.Peek(VAR AByte: Byte): Boolean;
BEGIN
IF RxBufPos=RxBufMax THEN ReadBlock(RxBuf^, RxBufSize, RxBufMax);
IF RxBufPos=RxBufMax THEN
Peek:=False
ELSE
BEGIN
AByte:=BT0(RxBuf^)[RxBufPos];
Peek:=True;
END;
END;
FUNCTION TAbsCom.KeyPressed : Boolean;
BEGIN
KeyPressed:=False;
END;
FUNCTION TAbsCom.OutEmpty : Boolean;
BEGIN
OutEmpty:=True;
END;
FUNCTION TAbsCom.Carrier : Boolean;
BEGIN
Carrier:=False;
END;
PROCEDURE TAbsCom.FlushTx;
BEGIN
WriteBlock(TxBuf^, TXBufPos);
TxBufPos:=0;
END;
PROCEDURE TAbsCom.FlushOut;
BEGIN
END;
PROCEDURE TAbsCom.PurgeOut;
BEGIN
END;
PROCEDURE TAbsCom.PurgeIn;
BEGIN
END;
PROCEDURE TAbsCom.SetDtr(High: Boolean);
BEGIN
END;
PROCEDURE TAbsCom.SendBreak;
BEGIN
END;
PROCEDURE TAbsCom.SetXOn(AMode: Boolean);
BEGIN
END;
PROCEDURE TAbsCom.SetFlowControl(AMask: Word);
BEGIN
END;
PROCEDURE TAbsCom.SetBreak(AMode: Boolean);
BEGIN
END;
PROCEDURE TAbsCom.SetLinkData(DB,SB,PB: BYTE);
BEGIN
IF DB=7 THEN DataBits:=2 ELSE DataBits:=3;
StopBits:=SB SHL 2;
ParityBits:=PB SHL 3;
SetBaudRate(CurrentBaud);
END;
FUNCTION TAbsCom.GetLinkData: S5;
VAR
s:S5;
BEGIN
CASE ParityBits OF
0,16 : s:='N-';
8 : s:='O-';
24 : s:='E-';
END;
s:=s+CHR(53+DataBits)+'-'+CHR(49+BYTE(StopBits=4));
GetLinkData:=s;
END;
PROCEDURE TAbsCom.WriteBlock(VAR ABuffer; ABufSize: Word);
BEGIN
END;
PROCEDURE TAbsCom.ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word);
BEGIN
RxBufPos:=0;
END;
FUNCTION TAbsCom.GetStatus: AStatus;
BEGIN
END;
{=== TFossilCom ===}
CONSTRUCTOR TFossilCom.Init(APort: Byte);
BEGIN
IF NOT INHERITED Init(APort) THEN Fail;
Regs.BX:=0;
CurrentPort:=APort-1;
FossilInt($04);
IF Regs.AX<>$1954 THEN
BEGIN
INHERITED Done;
Fail;
END;
END;
DESTRUCTOR TFossilCom.Done;
BEGIN
FossilInt($05);
INHERITED Done;
END;
FUNCTION TFossilCom.SetBaudRate(ABaudRate: Word): Boolean;
CONST
BaudRates : ARRAY[0..7] OF Word = (19200, 38400, 300, 600, 1200, 2400, 4800, 9600);
Order : ARRAY[0..7] OF Byte = (2,3,4,5,6,7,0,1);
VAR
a : Byte;
BEGIN
a:=0;
WHILE (a<8) AND (BaudRates[Order[a]]<ABaudRate) DO
Inc(a);
IF a=8 THEN
BEGIN
SetBaudRate:=False;
IF ABaudRate>2400 THEN CurrentBaud:=ABaudRate;
END ELSE
BEGIN
Regs.AL:=(Order[a] SHL 5)+ParityBits+StopBits+DataBits;
FossilInt($00);
SetBaudRate:=True;
LastStatus:=Regs.AX;
CurrentBaud:=ABaudRate;
END;
END;
FUNCTION TFossilCom.ReadByte: Byte;
BEGIN
IF RxBufPos=RxBufMax THEN ReadBlock(RxBuf^, RxBufSize, RxBufMax);
IF RxBufPos=RXBufMax THEN
BEGIN
FossilInt($02);
ReadByte:=Regs.AL;
END ELSE
BEGIN
ReadByte:=BT0(RxBuf^)[RxBufPos];
Inc(RxBufPos);
END;
END;
FUNCTION TFossilCom.KeyPressed : Boolean;
BEGIN
KeyPressed:=(RxBufPos<RxBufMax) OR ((Hi(GetStatus) AND RDA)=RDA);
END;
FUNCTION TFossilCom.OutEmpty : Boolean;
BEGIN
OutEmpty :=(TxBufPos=0) AND ((Hi(GetStatus) AND TSRE) = TSRE);
END;
FUNCTION TFossilCom.Carrier : Boolean;
BEGIN
Carrier := ((Lo(GetStatus) AND CarrierMask) = CarrierMask);
END;
PROCEDURE TFossilCom.FlushOut;
BEGIN
FlushTx;
FossilInt($08);
END;
PROCEDURE TFossilCom.PurgeOut;
BEGIN
TxBufPos:=0;
FossilInt($09);
END;
PROCEDURE TFossilCom.PurgeIn;
BEGIN
RxBufPos:=0; RxBufMax:=0;
FossilInt($0a);
END;
PROCEDURE TFossilCom.SetDtr(High: Boolean);
BEGIN
Regs.AL:=Byte(High);
FossilInt($06);
END;
PROCEDURE TFossilCom.SendBreak;
BEGIN
Regs.AL:=$01;
FossilInt($1a);
Pause(500);
Regs.AL:=$00;
FossilInt($1a);
END;
PROCEDURE TFossilCom.SetXOn(AMode: Boolean);
BEGIN
IF AMode = On THEN
Regs.AL:=11 {HandshakeMask}
ELSE
Regs.AL:=2; {HandshakeMask AND (NOT $01);}
FossilInt($0f);
END;
PROCEDURE TFossilCom.SetFlowControl(AMask: Word);
BEGIN
Regs.AX:=AMask OR $0F00;
FossilInt($0f);
END;
PROCEDURE TFossilCom.SetBreak(AMode: Boolean);
BEGIN
Regs.Al:=Byte(AMode);
FossilInt($10);
END;
FUNCTION TFossilCom.GetStatus: Word;
BEGIN
FossilInt($03);
GetStatus:=Regs.AX;
END;
PROCEDURE TFossilCom.WriteBlock(VAR ABuffer; ABufSize: Word);
BEGIN
Regs.CX:=ABufSize;
Regs.ES:=Seg(ABuffer);
Regs.DI:=Ofs(ABuffer);
REPEAT
FossilInt($19);
Regs.CX:=Regs.CX-Regs.AX;
Inc(Regs.DI, Regs.AX);
IF (Regs.CX>128) AND (MultiTasker=1) THEN GiveUpTime;
UNTIL (Regs.CX=0) OR NOT Carrier;
END;
PROCEDURE TFossilCom.ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word);
BEGIN
Regs.CX:=ABufSize;
Regs.ES:=Seg(ABuffer);
Regs.DI:=Ofs(ABuffer);
FossilInt($18);
ABufUsed:=Regs.AX;
RxBufPos:=0;
END;
PROCEDURE TFossilCom.FossilInt(AService: Byte);
BEGIN
Regs.AH := AService;
Regs.DX := CurrentPort;
{$IFDEF PMode}
RealModeInt($14, Regs);
{$ELSE}
Intr($14, Regs);
{$ENDIF}
END;
{$IFDEF OS2}
{=== TOS2Com ===}
CONSTRUCTOR TOS2Com.Init(APort: Byte);
VAR
Action : ULong;
Z : ARRAY[0..10] OF Char;
CH : HFile;
BEGIN
IF NOT INHERITED Init(APort) THEN Fail;
StrPCopy(Z, 'COM'+Long2Str(APort));
ChkErr(DosOpen(Z, CH, Action, 0, $0000,
OPEN_ACTION_OPEN_IF_EXISTS,
OPEN_ACCESS_READWRITE OR OPEN_SHARE_DENYREADWRITE OR OPEN_FLAGS_FAIL_ON_ERROR,
NIL),'DosOpen','OS2Com.Init');
ComHandle:=CH;
IF LastStatus<>No_Error THEN
BEGIN
WriteLn('ComPort open error: ',LastStatus);
INHERITED Done;
Fail;
END;
END;
DESTRUCTOR TOS2Com.Done;
BEGIN
ChkErr(DosClose(ComHandle),'DosClose','OS2Com.Done');
INHERITED Done;
END;
FUNCTION TOS2Com.SetBaudRate(ABaudRate: Word): Boolean;
VAR
ParmLen : ULong;
BaudRateRec : RECORD
BaudRate : ULONG;
Fraction : BYTE
END;
BEGIN
BaudRateRec.BaudRate:=ABaudRate;
BaudRateRec.Fraction:=0;
ParmLen:=SizeOf(BaudRateRec);
ChkErr(DosDevIoCtl(ComHandle,IOCtl_Async,Async_ExtSetBaudRate,@BaudRateRec,6,@ParmLen,NIL,0,NIL),
'DosDevIOCtl','FSetBaudR');
SetBaudRate:=(LastStatus=No_Error);
CurrentBaud:=ABaudRate;
END;
FUNCTION TOS2Com.ReadByte: Byte;
VAR
B : Byte;
BytesRead : Word;
BEGIN
IF RxBufPos=RxBufMax THEN ReadBlock(RxBuf^, RxBufSize, RxBufMax);
IF RxBufPos=RXBufMax THEN
BEGIN
ChkErr(DosRead(ComHandle,B,1,BytesRead),'DosRead','FReadByte');
ReadByte:=B;
END ELSE
BEGIN
ReadByte:=BT0(RxBuf^)[RxBufPos];
Inc(RxBufPos);
END;
END;
FUNCTION TOS2Com.KeyPressed : Boolean;
TYPE
BUFFREC = Record { For storing TX or RX buffer records }
Bytesin, { Number of bytes in buffer }
FullSize : word; { Size of the buffer }
end;
VAR
BufferRec : BuffRec;
RetLength : LongInt;
BEGIN
IF (RxBufPos<RxBufMax) THEN
KeyPressed:=True
ELSE
BEGIN
ChkErr(DosDevIOCtl(ComHandle,IOCtl_Async,Async_GetInQueCount,NIL,0,NIL,@BufferRec,SizeOf(BufferRec),@RetLength),
'DosDevIOCtl','TOS2Com.Keypressed');
KeyPressed:=(BufferRec.BytesIn>0);
END;
END;
FUNCTION TOS2Com.OutEmpty : Boolean;
BEGIN
{!!!}
OutEmpty :=(TxBufPos=0) AND ((Hi(GetStatus) AND TSRE) = TSRE);
END;
FUNCTION TOS2Com.Carrier : Boolean;
BEGIN
{!!!}
Carrier := ((Lo(GetStatus) AND CarrierMask) = CarrierMask);
END;
PROCEDURE TOS2Com.FlushOut;
BEGIN
FlushTx;
ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.FlushOut');
END;
PROCEDURE TOS2Com.PurgeOut;
BEGIN
TxBufPos:=0;
ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.PurgeOut');
END;
PROCEDURE TOS2Com.PurgeIn;
BEGIN
ReadBlock(RxBuf^, RxBufSize, RxBufMax);
RxBufPos:=0; RxBufMax:=0;
END;
PROCEDURE TOS2Com.SetDtr(High: Boolean);
VAR
MS : ModemStatus;
ComErr : Word;
ParmLen : ULONG;
BEGIN
FillChar(MS, SizeOf(MS), 0);
IF High THEN MS.fbModemOn:=dtr_On ELSE MS.fbModemOff:=dtr_Off;
ParmLen:=SizeOf(MS);
ChkErr(DosDevIoCtl(ComHandle,IOCtl_Async,Async_SetModemCtrl,@MS,SizeOf(MS),@ParmLen,@ComErr,SizeOf(ComErr),@ParmLen),
'DosDevIOCtl','FSetDtr');
END;
PROCEDURE TOS2Com.SendBreak;
BEGIN
ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.SendBreak');
END;
PROCEDURE TOS2Com.SetXOn(AMode: Boolean);
BEGIN
ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.SetXOn');
END;
PROCEDURE TOS2Com.SetFlowControl(AMask: Word);
BEGIN
ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.SetFlowControl');
END;
PROCEDURE TOS2Com.SetBreak(AMode: Boolean);
BEGIN
ChkErr(-1,'NOT IMPLEMENTED','TOS2Com.SetBreak');
END;
PROCEDURE TOS2Com.WriteBlock(VAR ABuffer; ABufSize: Word);
VAR
Written : ULong;
BEGIN
ChkErr(DosWrite(ComHandle,ABuffer,ABufSize,Written),'DosWrite','WriteBlock');
END;
PROCEDURE TOS2Com.ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word);
BEGIN
ChkErr(DosRead(ComHandle,ABuffer,ABufSize,ABufUsed),'DosRead','ReadBlock');
RxBufPos:=0;
END;
FUNCTION TOS2Com.GetStatus: Word;
VAR
status : byte;
retlength : longint;
BEGIN
ChkErr(DosDevIOCtl(ComHandle,IOCtl_Async,Async_GetModemInput,NIL,0,NIL,@status,1,@retlength),'DosDevIOCtl','FGetStatus');
GetStatus:=Status;
END;
PROCEDURE TOS2Com.ChkErr(ErrCode: ApiRet; DosCall, FctName: S40);
BEGIN
IF ErrCode<>No_Error THEN
BEGIN
AddLog('!', 'FOSSIL: Error '+Long2Str(ErrCode)+' from '+DosCall+' in '+FctName);
END;
LastStatus:=ErrCode;
END;
{=== TMaxCom ===}
{$IFDEF MaxComm}
CONSTRUCTOR TMaxCom.Init(APort: Byte);
VAR
Action : ULong;
Z : ARRAY[0..10] OF Char;
{ CH : HFile;}
BEGIN
IF NOT INHERITED Init(APort) THEN Fail;
StrPCopy(Z, 'COM'+Long2Str(APort));
ChkErr(ComOpen(Z, ComHandle, 4096, 4096),'ComOpen','TMaxCom.Init');
IF LastStatus<>No_Error THEN
BEGIN
WriteLn('ComPort open error: ',LastStatus);
INHERITED Done;
Fail;
END;
END;
DESTRUCTOR TMaxCom.Done;
BEGIN
ChkErr(ComClose(ComHandle),'ComClose','TMaxCom.Done');
INHERITED Done;
END;
FUNCTION TMaxCom.SetBaudRate(ABaudRate: Word): Boolean;
BEGIN
ChkErr(ComSetBaudRate(ComHandle, ABaudRate, 'N', 8, 1), 'ComSetBaudRate', 'SetBaudRate');
SetBaudRate:=(LastStatus=No_Error);
CurrentBaud:=ABaudRate;
END;
FUNCTION TMaxCom.ReadByte: Byte;
VAR
B : Byte;
BytesRead : Word;
i : SHORT;
BEGIN
IF RxBufPos=RxBufMax THEN ReadBlock(RxBuf^, RxBufSize, RxBufMax);
IF RxBufPos=RXBufMax THEN
BEGIN
i:=ComGetc(ComHandle);
IF i>=0 THEN ReadByte:=Lo(i) ELSE B:=0;
END ELSE
BEGIN
ReadByte:=BT0(RxBuf^)[RxBufPos];
Inc(RxBufPos);
END;
END;
FUNCTION TMaxCom.KeyPressed : Boolean;
BEGIN
IF (RxBufPos<RxBufMax) THEN
KeyPressed:=True
ELSE
BEGIN
KeyPressed:=(ComInCount(ComHandle)>0);
END;
END;
FUNCTION TMaxCom.OutEmpty : Boolean;
BEGIN
OutEmpty :=(TxBufPos=0) AND (ComOutCount(ComHandle)=0);
END;
FUNCTION TMaxCom.Carrier : Boolean;
BEGIN
Carrier := Bool(ComIsOnline(ComHandle));
END;
PROCEDURE TMaxCom.FlushOut;
BEGIN
FlushTx;
ChkErr(ComTxWait(ComHandle, -1),'ComTxWait','TMaxCom.FlushOut');
END;
PROCEDURE TMaxCom.PurgeOut;
BEGIN
TxBufPos:=0;
ChkErr(ComPurge(ComHandle, COMM_PURGE_TX),'ComPurge','TMaxCom.PurgeOut');
END;
PROCEDURE TMaxCom.PurgeIn;
BEGIN
ChkErr(ComPurge(ComHandle, COMM_PURGE_RX),'ComPurge','TMaxCom.PurgeOut');
RxBufPos:=0; RxBufMax:=0;
END;
PROCEDURE TMaxCom.SetDtr(High: Boolean);
VAR
MS : ModemStatus;
ComErr : Word;
ParmLen : ULONG;
BEGIN
{
FillChar(MS, SizeOf(MS), 0);
IF High THEN MS.fbModemOn:=dtr_On ELSE MS.fbModemOff:=dtr_Off;
ParmLen:=SizeOf(MS);
ChkErr(DosDevIoCtl(ComHandle,IOCtl_Async,Async_SetModemCtrl,@MS,SizeOf(MS),@ParmLen,@ComErr,SizeOf(ComErr),@ParmLen),
'DosDevIOCtl','FSetDtr');}
ChkErr(-1,'NOT IMPLEMENTED???!!!','SetDtr');
END;
PROCEDURE TMaxCom.SendBreak;
BEGIN
ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.SendBreak');
END;
PROCEDURE TMaxCom.SetXOn(AMode: Boolean);
BEGIN
ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.SetXOn');
END;
PROCEDURE TMaxCom.SetFlowControl(AMask: Word);
BEGIN
ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.SetFlowControl');
END;
PROCEDURE TMaxCom.SetBreak(AMode: Boolean);
BEGIN
ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.SetBreak');
END;
PROCEDURE TMaxCom.WriteBlock(VAR ABuffer; ABufSize: Word);
VAR
Written : ULong;
BEGIN
ChkErr(ComWrite(ComHandle,ABuffer,ABufSize),'ComWrite','TMaxCom.WriteBlock');
END;
PROCEDURE TMaxCom.ReadBlock(VAR ABuffer; ABufSize: Word; VAR ABufUsed: Word);
BEGIN
ChkErr(ComRead(ComHandle,ABuffer,ABufSize,ABufUsed),'ComRead','TMaxCom.ReadBlock');
RxBufPos:=0;
END;
FUNCTION TMaxCom.GetStatus: Word;
VAR
status : byte;
retlength : longint;
BEGIN
{ ChkErr(DosDevIOCtl(ComHandle,IOCtl_Async,Async_GetModemInput,NIL,0,NIL,@status,1,@retlength),
'DosDevIOCtl','FGetStatus');}
ChkErr(-1,'NOT IMPLEMENTED','TMaxCom.GetStatus');
GetStatus:=0;
END;
PROCEDURE TMaxCom.ChkErr(ErrCode: ApiRet; DosCall, FctName: S40);
BEGIN
IF ErrCode<>No_Error THEN
BEGIN
AddLog('!', 'FOSSIL: Error '+Long2Str(ErrCode)+' from '+DosCall+' in '+FctName);
END;
LastStatus:=ErrCode;
END;
{$ENDIF}
{$ENDIF}
END.